home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / share / mc / extfs / dpkg < prev    next >
Text File  |  2009-10-25  |  9KB  |  338 lines
  1. #! /usr/bin/perl
  2. #
  3. # 1999 (c) Piotr Roszatycki <dexter@debian.org>
  4. # This software is under GNU license
  5. # last modification: 1999-12-08
  6. #
  7. # dpkg
  8.  
  9. sub quote {
  10.     $_ = shift(@_);
  11.     s/([^\w\/.+-])/\\$1/g;
  12.     return($_);
  13. }
  14.  
  15. sub bt
  16. {
  17.     my ($dt) = @_;
  18.     my (@time);
  19.     @time = localtime($dt);
  20.     $bt = sprintf "%02d-%02d-%d %02d:%02d", $time[4] + 1, $time[3],
  21.           $time[5] + 1900, $time[2], $time[1];
  22.     return $bt;
  23. }
  24.  
  25.  
  26. sub ft
  27. {
  28.     my ($f) = @_;
  29.     return "d" if -d $f;
  30.     return "l" if -l $f;
  31.     return "p" if -p $f;
  32.     return "S" if -S $f;
  33.     return "b" if -b $f;
  34.     return "c" if -c $f;
  35.     return "-";
  36. }
  37.  
  38. sub fm
  39. {
  40.     my ($n) = @_;
  41.     my ($m);
  42.  
  43.     if( $n & 0400 ) {
  44.        $m .= "r";
  45.     } else {
  46.        $m .= "-";
  47.     }
  48.     if( $n & 0200 ) {
  49.        $m .= "w";
  50.     } else {
  51.        $m .= "-";
  52.     }
  53.     if( $n & 04000 ) {
  54.        $m .= "s";
  55.     } elsif( $n & 0100 ) {
  56.        $m .= "x";
  57.     } else {
  58.        $m .= "-";
  59.     }
  60.  
  61.     if( $n & 0040 ) {
  62.        $m .= "r";
  63.     } else {
  64.        $m .= "-";
  65.     }
  66.     if( $n & 0020 ) {
  67.        $m .= "w";
  68.     } else {
  69.        $m .= "-";
  70.     }
  71.     if( $n & 02000 ) {
  72.        $m .= "s";
  73.     } elsif( $n & 0010 ) {
  74.        $m .= "x";
  75.     } else {
  76.        $m .= "-";
  77.     }
  78.  
  79.     if( $n & 0004 ) {
  80.        $m .= "r";
  81.     } else {
  82.        $m .= "-";
  83.     }
  84.     if( $n & 0002 ) {
  85.        $m .= "w";
  86.     } else {
  87.        $m .= "-";
  88.     }
  89.     if( $n & 01000 ) {
  90.        $m .= "t";
  91.     } elsif( $n & 0001 ) {
  92.        $m .= "x";
  93.     } else {
  94.        $m .= "-";
  95.     }
  96.  
  97.     return $m;
  98. }
  99.  
  100. sub ls {
  101.     my ($file,$path,$mode) = @_;
  102.  
  103.     if (-f $file) {
  104.     my @stat = stat(_);
  105.     # mode, nlink, uid, gid, size, mtime, filename
  106.     printf "%s %d %d %d %d %s %s\n", $mode || ft($file).fm($stat[2] & 07777),
  107.       $stat[3], $stat[4], $stat[5], $stat[7], bt($stat[9]), $path;
  108.     }
  109. }
  110.  
  111. $DATE=bt(time());
  112.  
  113. sub list
  114. {
  115.     my ($pkg, $fn, $dn, $sz, $bt);
  116.     my %debs = ();
  117.     my %sects = ();
  118.  
  119.     my($diversions,$architecture);
  120.     chop($diversions = `dpkg-divert --list 2>/dev/null`);
  121.     chop($architecture = `dpkg-architecture 2>/dev/null`);
  122.     chop($list = `dpkg -l '*' 2>/dev/null`);
  123.     chop($getselections = `dpkg --get-selections 2>/dev/null`);
  124.     chop($audit = `dpkg --audit 2>/dev/null`);
  125.     $sz = length($diversions);
  126.     print "-r--r--r-- 1 root root $sz $DATE DIVERSIONS\n";
  127.     $sz = length($architecture);
  128.     print "-r--r--r-- 1 root root $sz $DATE ARCHITECTURE\n";
  129.     $sz = length($list);
  130.     print "-r--r--r-- 1 root root $sz $DATE LIST\n";
  131.     $sz = length($getselections);
  132.     print "-r--r--r-- 1 root root $sz $DATE GET-SELECTIONS\n";
  133.     $sz = length($audit);
  134.     print "-r--r--r-- 1 root root $sz $DATE AUDIT\n";
  135.     $sz = length($pressconfigure);
  136.     print "-r-xr--r-- 1 root root $sz $DATE CONFIGURE\n";
  137.     $sz = length($pressremove);
  138.     print "-r-xr--r-- 1 root root $sz $DATE REMOVE\n";
  139.     $sz = length($pressclearavail);
  140.     print "-r-xr--r-- 1 root root $sz $DATE CLEAR-AVAIL\n";
  141.     $sz = length($pressforgetoldunavail);
  142.     print "-r-xr--r-- 1 root root $sz $DATE FORGET-OLD-UNAVAIL\n";
  143.     ls("/var/lib/dpkg/status","STATUS","-r--r--r--");
  144.     # ls("/var/lib/dpkg/available","AVAILABLE","-r--r--r--");
  145.  
  146.     print "drwxr-xr-x 1 root root 0 $DATE all\n";
  147.  
  148.     open STAT, "/var/lib/dpkg/status"
  149.        or exit 1;
  150.     while( <STAT> ) {
  151.        chop;
  152.        if( /^([\w-]*): (.*)/ ) {
  153.            $pkg = $2 if( lc($1) eq 'package' );
  154.            $debs{$pkg}{lc($1)} = $2;
  155.        }
  156.     }
  157.     close STAT;
  158.  
  159.     foreach $pkg (sort keys %debs) {
  160.        next if $debs{$pkg}{status} =~ /not-installed/;
  161.        $fn = $debs{$pkg}{package}. "_". $debs{$pkg}{version};
  162.        $dn = $debs{$pkg}{section};
  163.        if( ! $dn ) {
  164.            $dn = "unknown";
  165.        } elsif( $dn =~ /^(non-us)$/i ) {
  166.            $dn .= "/main";
  167.        } elsif( $dn !~ /\// ) {
  168.            $dn = "main/". $dn;
  169.        }
  170.        unless( $sects{$dn} ) {
  171.            my $sub = $dn;
  172.            while( $sub =~ s!^(.*)/[^/]*$!$1! ) {
  173.                unless( $sects{$sub} ) {
  174.                    print "drwxr-xr-x 1 root root 0 $DATE $sub/\n";
  175.                    $sects{$sub} = 1;
  176.                }
  177.            }
  178.            print "drwxr-xr-x 1 root root 0 $DATE $dn/\n";
  179.            $sects{$dn} = 1;
  180.        }
  181.        $sz = $debs{$pkg}{'status'} =~ /config-files/ ? 0 : $debs{$pkg}{'installed-size'} * 1024;
  182.        @stat = stat("/var/lib/dpkg/info/".$debs{$pkg}{package}.".list");
  183.        $bt = bt($stat[9]);
  184.        print "-rw-r--r-- 1 root root $sz $bt $dn/$fn.debd\n";
  185.        print "lrwxrwxrwx 1 root root $sz $bt all/$fn.debd -> ../$dn/$fn.debd\n";
  186.     }
  187. }
  188.  
  189. sub copyout
  190. {
  191.     my($archive,$filename) = @_;
  192.     my $qfilename = quote($filename);
  193.     if( $archive eq 'DIVERSIONS' ) {
  194.        system("dpkg-divert --list > $qfilename 2>/dev/null");
  195.     } elsif( $archive eq 'ARCHITECTURE' ) {
  196.        system("dpkg-architecture > $qfilename 2>/dev/null");
  197.     } elsif( $archive eq 'LIST' ) {
  198.        system("dpkg -l '*' > $qfilename 2>/dev/null");
  199.     } elsif( $archive eq 'AUDIT' ) {
  200.        system("dpkg --audit > $qfilename 2>/dev/null");
  201.     } elsif( $archive eq 'GET-SELECTIONS' ) {
  202.        system("dpkg --get-selections > $qfilename 2>/dev/null");
  203.     } elsif( $archive eq 'STATUS' ) {
  204.        system("cp /var/lib/dpkg/status $qfilename");
  205.     } elsif( $archive eq 'AVAILABLE' ) {
  206.        system("cp /var/lib/dpkg/available $qfilename");
  207.     } elsif( $archive eq 'CONFIGURE' ) {
  208.        open O, ">$filename";
  209.        print O $pressconfigure;
  210.        close O;
  211.     } elsif( $archive eq 'REMOVE' ) {
  212.        open O, ">$filename";
  213.        print O $pressremove;
  214.        close O;
  215.     } elsif( $archive eq 'CLEAR-AVAIL' ) {
  216.        open O, ">$filename";
  217.        print O $pressclearavail;
  218.        close O;
  219.     } elsif( $archive eq 'FORGET-OLD-UNAVAIL' ) {
  220.        open O, ">$filename";
  221.        print O $pressforgetoldunavail;
  222.        close O;
  223.     } else {
  224.        open O, ">$filename";
  225.        print O $archive, "\n";
  226.        close O;
  227.     }
  228. }
  229.  
  230. # too noisy but less dangerouse
  231. sub copyin
  232. {
  233.     my($archive,$filename) = @_;
  234.     my $qfilename = quote($filename);
  235.     if( $archive =~ /\.deb$/ ) {
  236.        system("dpkg -i $qfilename>/dev/null");
  237.     } else {
  238.        die "extfs: cannot create regular file \`$archive\': Permission denied\n";
  239.     }
  240. }
  241.  
  242. sub run
  243. {
  244.     my($archive,$filename) = @_;
  245.     if( $archive eq 'CONFIGURE' ) {
  246.        system("dpkg --pending --configure");
  247.     } elsif( $archive eq 'REMOVE' ) {
  248.        system("dpkg --pending --remove");
  249.     } elsif( $archive eq 'CLEAR-AVAIL' ) {
  250.        system("dpkg --clear-avail");
  251.     } elsif( $archive eq 'FORGET-OLD-UNAVAIL' ) {
  252.        system("dpkg --forget-old-unavail");
  253.     } else {
  254.        die "extfs: $filename: command not found\n";
  255.     }
  256. }
  257.  
  258. # Disabled - too dangerous and too noisy
  259. sub rm_disabled
  260. {
  261.     my($archive) = @_;
  262.     if( $archive =~ /\.debd?$/ ) {
  263.        my $qname = quote($archive);
  264.        $qname =~ s%.*/%%g;
  265.        $qname =~ s%_.*%%g;
  266.        system("if dpkg -s $qname | grep ^Status | grep -qs config-files; \
  267.            then dpkg --purge $qname>/dev/null; \
  268.            else dpkg --remove $qname>/dev/null; fi");
  269.        die("extfs: $archive: Operation not permitted\n") if $? != 0;
  270.     } else {
  271.        die "extfs: $archive: Operation not permitted\n";
  272.     }
  273. }
  274.  
  275.  
  276. $pressconfigure=<<EOInstall;
  277.  
  278.                               WARNING
  279.      Don\'t use this method if you are not willing to configure all
  280.                      non configured packages.
  281.  
  282. This is not a real file. It is a way to configure all non configured packages.
  283.  
  284. To configure packages go back to the panel and press Enter on this file.
  285.  
  286. EOInstall
  287.  
  288. $pressremove=<<EOInstall;
  289.  
  290.                               WARNING
  291.      Don\'t use this method if you are not willing to remove all 
  292.                       unselected packages.
  293.  
  294. This is not a real file. It is a way to remove all unselected packages.
  295.  
  296. To remove packages go back to the panel and press Enter on this file.
  297.  
  298. EOInstall
  299.  
  300. $pressforgetoldunavail=<<EOInstall;
  301.  
  302.                               WARNING
  303.      Don\'t use this method if you are not willing to forget about
  304.                  uninstalled unavailable packages.
  305.  
  306. This is not a real file. It is a way to forget about uninstalled
  307. unavailable packages.
  308.  
  309. To forget this information go back to the panel and press Enter on this file.
  310.  
  311. EOInstall
  312.  
  313. $pressclearavail=<<EOInstall;
  314.  
  315.                               WARNING
  316.      Don\'t use this method if you are not willing to erase the existing
  317.            information about what packages are available.
  318.  
  319. This is not a real file. It is a way to erase the existing information
  320. about what packages are available.
  321.  
  322. To clear this information go back to the panel and press Enter on this file.
  323.  
  324. EOInstall
  325.  
  326.  
  327.  
  328. # override any locale for dates
  329. $ENV{"LC_ALL"}="C";
  330.  
  331. if ($ARGV[0] eq "list") { list(); exit(0); }
  332. elsif ($ARGV[0] eq "copyout") { copyout($ARGV[2], $ARGV[3]); exit(0); }
  333. elsif ($ARGV[0] eq "copyin") { copyin($ARGV[2], $ARGV[3]); exit(0); }
  334. elsif ($ARGV[0] eq "run") { run($ARGV[2],$ARGV[3]); exit(0); }
  335. #elsif ($ARGV[0] eq "rm") { rm($ARGV[2]); exit(0); }
  336. exit(1);
  337.  
  338.